home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textfile.swg / 0014_A good FILEVIEW unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-17  |  3.7 KB  |  152 lines
  1. ===========================================================================
  2.  BBS: Canada Remote Systems
  3. Date: 08-09-93 (11:14)             Number: 33641
  4. From: NORBERT IGL                  Refer#: NONE
  5.   To: MARK GRYN                     Recvd: NO  
  6. Subj: FILE VIEWER                    Conf: (1221) F-PASCAL
  7. ---------------------------------------------------------------------------
  8. Hello Mark!
  9. One of these days, Mark Gryn wrote to all:
  10.  
  11.  MG>     I'm wondering if anyone has some code laying around for a 'file'
  12.  MG> viewer.
  13.  
  14.  TAKE THIS! (:-)
  15.  
  16.  Program Viewer;
  17.  (*$M $800,0,$A0000 *)
  18.  
  19.  Uses
  20.     crt;
  21.  
  22.  Type    TextBlock = Array[1..16209] of ^String; { lines enough? 8-) }
  23.  
  24.  Var     VText : TextBlock;
  25.          Lines : integer;
  26.          Last  : integer;
  27.  
  28.  Procedure Init(N:string);
  29.  Var F: text;
  30.      S: String;
  31.  begin
  32.    FillChar( VText, Sizeof(Vtext), 0 );
  33.    Lines := 0;
  34.    Assign( f, N );
  35. (*$I-*)
  36.    Reset( f );
  37. (*$I+*)
  38.    If IoResult <> 0 then exit;
  39.    While ( not EOF( F ) )
  40.      AND ( Maxavail > 80 )   do  { assume a 80-Char-String }
  41.    begin
  42.       Inc( Lines );
  43.       ReadLn( F, S );
  44.       If Length(S) > 80
  45.         Then S[0] := #80;
  46.       GetMem( Vtext[Lines], 1+Length(S) );
  47.       VText[Lines]^ := S;
  48.    end;
  49.    Last := Lines;
  50.    if not eof( F )
  51.      then Write(' Sorry, only ')
  52.      else Write(' All ');
  53.    Writeln( Lines,' Lines of ', N , ' read. ');
  54.    Close( F );
  55.  end;
  56.  
  57.  Procedure Display(N:String);
  58.  Var ch : Char;
  59.      akt: integer;
  60.      Procedure Update;
  61.      Var y,i: integer;
  62.      begin
  63.        if akt > ( Last - 22 )
  64.           then akt := last - 22;
  65.        if akt < 1
  66.           then akt := 1;
  67.        y := 2;
  68.        for  i := akt to akt + 22 do
  69.        begin
  70.          gotoxy( 1, y );
  71.          ClrEol;
  72.          inc( y );
  73.          if i <= Last then write( VText[i]^ );
  74.        end;
  75.        TextAttr := $70;  (* Black on Gray *)
  76.        Gotoxy(70,25);
  77.        if akt+23 > Last
  78.          then Write(akt,'..',Last)
  79.          else Write(akt,'..',akt+22);
  80.        ClrEol
  81.      end;
  82.  begin
  83.    TextAttr := $70;  (* Black on Gray *)
  84.    ClrScr;
  85.    Gotoxy( 2, 1);
  86.    Write('The All Dancing and Singing Textfile Viewer');
  87.    Write('     Norbert Igl, 2:243/8301.3@Fido');
  88.    Gotoxy( 2,25);
  89.    while Pos('\',N) > 0 do delete(n,1,1);
  90.    for akt := 1 to length(N) do N[akt] := upcase(n[akt]);
  91.    Write('File: ',N,', ',Last,' Lines,  ');
  92.    Write( MemAvail,' Bytes free.');
  93.    Gotoxy(63,25); Write('Lines: ');
  94.    akt := 1;
  95.    repeat
  96.      TextAttr := $1F;  { white on blue }
  97.      Update;
  98.      repeat
  99.         ch := ReadKey;
  100.         if ch = #0 then
  101.         begin
  102.           ch := readkey;
  103.           case ch of
  104.           'H' : ch := #1; { up }
  105.           'P' : ch := #2; { down }
  106.           'Q' : ch := #3; { pg-up }
  107.           'I' : ch := #4; { pg-down }
  108.           'G' : ch := #5; { home }
  109.           'O' : ch := #6; { end }
  110.           else ch := #0;  { discard }
  111.         end
  112.         end
  113.      until Ch in [#27, #1..#6 ] ;
  114.      case Ch of
  115.        #1 : dec( akt );
  116.        #2 : inc( akt );
  117.        #3 : inc( akt, 22 );
  118.        #4 : dec( akt, 22 );
  119.        #5 : akt := 1;
  120.        #6 : akt := last-22;
  121.      end;
  122.   until ch=#27;
  123.  end;
  124.  
  125.  procedure CleanUp;
  126.  Var I : Integer;
  127.  begin
  128.    for I := last downto 1 do
  129.      FreeMem( Vtext[i], 1+Length(VText[i]^) );
  130.    TextAttr := 7;
  131.    ClrScr;
  132.  end;
  133.  
  134.  begin
  135.    if Paramcount <> 1 then
  136.    begin
  137.      writeln(' Usage :  VIEWER [Drive:[\Path\]] FileName.Ext');
  138.      halt
  139.    end;
  140.    Init(paramstr(1));
  141.    if Lines > 0 then
  142.    begin
  143.      Display(paramstr(1));
  144.      CleanUp
  145.    end;
  146.  end.
  147.  
  148.  hth, Norbert
  149.  
  150. --- GoldEd 2.40p/FD2.02/FastEcho
  151.  * Origin: GHOSTBUSTERS: We're afraid of no code... (2:243/8301.3)
  152.